home *** CD-ROM | disk | FTP | other *** search
/ Power CD / Power CD ATARI-Rechner Lieben.iso / ALLERLEI / GOBJ_112 / SOURCE / BEISPIEL / BEISPL03.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-03-03  |  2.6 KB  |  115 lines
  1. program Beispiel; {$X+} { Beispiel Nr.3 }
  2.  
  3. uses
  4.  
  5.     Gem,OTypes,OProcs,OWindows;
  6.  
  7. type
  8.  
  9.     TMyApplication = object(TApplication)
  10.         procedure InitMainWindow; virtual;
  11.     end;
  12.  
  13.     PBeispielWindow = ^TBeispielWindow;
  14.     TBeispielWindow = object(TWindow)
  15.         Veraendert: boolean;
  16.         Dicke,
  17.         Farbe,
  18.         Art       : integer;
  19.         constructor Init(AParent: PWindow; ATitle: string);
  20.         function CanClose: boolean; virtual;
  21.         procedure WMButton(mX,mY,BStat,KStat,Clicks: integer); virtual;
  22.         procedure SetAttr(Width,Color,Style: integer); virtual;
  23.     end;
  24.  
  25. var
  26.  
  27.     MyApp: TMyApplication;
  28.  
  29.  
  30. procedure TMyApplication.InitMainWindow;
  31.  
  32.     begin
  33.         new(PBeispielWindow,Init(nil,'ObjectGEM-Beispielprogramm'));
  34.         if (MainWindow=nil) or (ChkError<em_OK) then
  35.             Status:=em_InvalidMainWindow
  36.     end;
  37.  
  38.  
  39. constructor TBeispielWindow.Init(AParent: PWindow; ATitle: string);
  40.  
  41.     begin
  42.         if not(inherited Init(AParent,ATitle)) then fail;
  43.         Veraendert:=false;
  44.         SetAttr(3,Blue,LT_SOLID)
  45.     end;
  46.  
  47.  
  48. function TBeispielWindow.CanClose: boolean;
  49.     var valid: boolean;
  50.  
  51.     begin
  52.         valid:=inherited CanClose;
  53.         if valid and Veraendert then
  54.             valid:=(Application^.Alert(@self,1,WAIT,
  55.                 ' Die Grafik wurde verändert!| Wollen Sie sie speichern?',
  56.               '&Ja|  &Nein  ')=2);
  57.         CanClose:=valid
  58.     end;
  59.  
  60.  
  61. procedure TBeispielWindow.WMButton(mX,mY,BStat,KStat,Clicks: integer);
  62.     var xalt,yalt,btn,dummy: integer;
  63.         pxyarray           : ptsin_ARRAY;
  64.  
  65.     begin
  66.         if bTst(BStat,1) then
  67.             if GetDC>=0 then
  68.                 begin
  69.                     wind_update(BEG_MCTRL);
  70.                     vsl_width(vdiHandle,Dicke);
  71.                     vsl_color(vdiHandle,Farbe);
  72.                     vsl_type(vdiHandle,Art);
  73.                     repeat
  74.                         xalt:=mX;
  75.                         yalt:=mY;
  76.                         repeat
  77.                             graf_mkstate(mX,mY,btn,dummy)
  78.                         until (mX<>xalt) or (mY<>yalt) or not(bTst(btn,1));
  79.                         pxyarray[0]:=xalt;
  80.                         pxyarray[1]:=yalt;
  81.                         pxyarray[2]:=mX;
  82.                         pxyarray[3]:=mY;
  83.                         v_pline(vdiHandle,2,pxyarray)
  84.                     until not(bTst(btn,1));
  85.                     wind_update(END_MCTRL);
  86.                     ReleaseDC;
  87.                     Veraendert:=true
  88.                 end;
  89.         if bTst(BStat,2) then
  90.             begin
  91.                 ForceRedraw;
  92.                 Veraendert:=false
  93.             end
  94.     end;
  95.  
  96.  
  97. procedure TBeispielWindow.SetAttr(Width,Color,Style: integer);
  98.     const farben: array [0..7] of string[7] =
  99.         ('weiß','schwarz','rot','grün','blau','türkis','gelb','violett');
  100.                 arten: array [1..6] of string[16] =
  101.         ('durchgehend','langer Strich','Punkte','Strich, Punkt','Strich','Strich, 2 Punkte');
  102.  
  103.     begin
  104.         Dicke:=Width;
  105.         Farbe:=Color;
  106.         Art:=Style;
  107.         SetSubTitle(' Dicke: '+ltoa(Dicke)+'  Farbe: '+farben[Farbe]+'   Art: '+arten[Art])
  108.     end;
  109.  
  110.  
  111. begin
  112.     MyApp.Init('BSPL','Beispiel');
  113.     MyApp.Run;
  114.     MyApp.Done
  115. end.